ایجاد یک وقفه

Procedure Pause(HS : longint); assembler;
Asm
        mov     es,Seg0040
        mov     si,006Ch
        mov     dx,word ptr es:[si+2]
        mov     ax,word ptr es:[si]
        add     ax,word ptr [HS]
        adc     dx,word ptr [HS+2]
@@1:
        mov     bx,word ptr es:[si+2]
        cmp     word ptr es:[si+2],dx
        jl      @@1
        mov     cx,word ptr es:[si]
        cmp     word ptr es:[si],ax
        jl      @@1
End;

ایجاد حاشیه در memo

var Rect: TRect;
begin
  SendMessage( Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect));
  Rect.Left:= 20;
  SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect));
  Memo1.Refresh;var Rect: TRect;
begin
  SendMessage( Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect));
  Rect.Left:= 30;
  SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect));
  Memo1.Refresh;

برای تبدیل انواع متغیرها به رشته

function ValToString(Value: Variant): String;
begin
  case TVarData(Value).VType of
    varSmallInt,
    varInteger   : Result := IntToStr(Value);
    varSingle,
    varDouble,
    varCurrency  : Result := FloatToStr(Value);
    varDate      : Result := FormatDateTime('dd.mm.yyyy', Value);
    varBoolean   : if Value then Result := 'T' else Result := 'F';
    varString    : Result := Value;
    else            Result := '';
  end;
end;

24 ساعت فیلم آموزشی دلفی به زبان فارسی

با سلام

24 ساعت فیلم آموزشی دلفی در قالب 47 درس از آقای شاهین عشایری بجنبید دانلود کنید تا از دستتون نرفته.

                                  دانلود

Transparent Memo

unit TrMemo;



{$R-}



interface



uses

  Messages, Controls, StdCtrls, classes;



const

  TMWM_SpecialInvalidate = WM_USER + 1111;



type

  TTransparentMemo = class(TMemo)

  private

    procedure SpecialInvalidate(var Message: TMessage);

      message TMWM_SpecialInvalidate;

    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;

    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;

    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;

    procedure CNCTLCOLOREDIT(var Message: TWMCTLCOLOREDIT);

      message CN_CTLCOLOREDIT;

    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;

    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;

  protected

    procedure CreateParams(var Params: TCreateParams); override;

  public

    constructor Create(AOwner: TComponent); override;

  end;



procedure Register;



implementation



uses

  Windows;



{ TTransparentMemo }



procedure TTransparentMemo.WMHScroll(var Message: TWMHScroll);

begin

  inherited;

  PostMessage(Handle, TMWM_SpecialInvalidate, 0, 0);

end;



procedure TTransparentMemo.WMVScroll(var Message: TWMVScroll);

begin

  SendMessage(Handle, TMWM_SpecialInvalidate, 0, 0);

  inherited;

  PostMessage(Handle, TMWM_SpecialInvalidate, 0, 0);

end;



procedure TTransparentMemo.CNCTLCOLOREDIT(var Message: TWMCTLCOLOREDIT);

begin

  with Message do

  begin

    SetBkMode(ChildDC, TRANSPARENT);

    Result := GetStockObject(HOLLOW_BRUSH);

  end;

end;



procedure TTransparentMemo.WMSetText(var Message: TWMSetText);

begin

  inherited;

  if not (csDesigning in ComponentState) then

    PostMessage(Handle, TMWM_SpecialInvalidate, 0, 0)

end;



procedure TTransparentMemo.SpecialInvalidate(var Message: TMessage);

var

  r: TRect;

begin

  if Parent <> nil then

  begin

    r := ClientRect;

    r.TopLeft := Parent.ScreenToClient(ClientToScreen(r.TopLeft));

    r.BottomRight := Parent.ScreenToClient(ClientToScreen(r.BottomRight));

    InvalidateRect(Parent.Handle, @r, true);

    RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE)

  end;

end;



procedure TTransparentMemo.WMKeyDown(var Message: TWMKeyDown);

begin

  SendMessage(Handle, TMWM_SpecialInvalidate, 0, 0);

  inherited;

  PostMessage(Handle, TMWM_SpecialInvalidate, 0, 0);

end;



procedure TTransparentMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);

begin

  Message.Result := 1

end;



constructor TTransparentMemo.Create(AOwner: TComponent);

begin

  inherited;

  ControlStyle := [csCaptureMouse, csDesignInteractive, csClickEvents,

    csSetCaption, csOpaque, csDoubleClicks, csReplicatable, csNoStdEvents];

end;



procedure TTransparentMemo.CreateParams(var Params: TCreateParams);

begin

  inherited CreateParams(Params);

  with Params do

  begin

   ExStyle := ExStyle or WS_EX_TRANSPARENT and not WS_EX_WINDOWEDGE

    and not WS_EX_STATICEDGE and not WS_EX_DLGMODALFRAME and not

    WS_EX_CLIENTEDGE;

  end;

end;



procedure Register;

begin

  RegisterComponents('Saberi', [tTransparentMemo]);

end;



end.

Example

var
  xmemo:TTransparentMemo;
begin
  xmemo:=TTransparentMemo.Create(Self);
  xmemo.ParentWindow:=Form1.Handle;
  xmemo.Height:=100;
  xmemo.Lines.Add('Saeed Saberi');

balloon tooltip

یک balloon tooltib زیبا و کاربردی در دلفی یک تابع برای نمایش است که شما را از استفاده کامپوننت بی نیاز می کند!

USES commctrl;

procedure BalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text: PWideChar;
BackCL, TextCL: TColor);
const
  TOOLTIPS_CLASS = 'tooltips_class32';
  TTS_ALWAYSTIP = $01;
  TTS_NOPREFIX = $02;
  TTS_BALLOON = $40;
  TTF_SUBCLASS = $0010;
  TTF_TRANSPARENT = $0100;
  TTF_CENTERTIP = $0002;
  TTM_ADDTOOL = $0400 + 50;
  TTM_SETTITLE = (WM_USER + 32);
  ICC_WIN95_CLASSES = $000000FF;
type
  TOOLINFO = packed record
    cbSize: Integer;
    uFlags: Integer;
    hwnd: THandle;
    uId: Integer;
    rect: TRect;
    hinst: THandle;
    lpszText: PWideChar;
    lParam: Integer;
  end;
var
  hWndTip: THandle;
  ti: TOOLINFO;
  hWnd: THandle;
begin
  hWnd    := Control.Handle;
  hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
    0, 0, 0, 0, hWnd, 0, HInstance, nil);
  if hWndTip <> 0 then
  begin
    SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
    ti.cbSize := SizeOf(ti);
    ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
    ti.hwnd := hWnd;
    ti.lpszText := Text;
    GetClientRect(hWnd, ti.rect);
    SendMessage(hWndTip, TTM_SETTIPBKCOLOR, BackCL, 0);
    SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, TextCL, 0);
    SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
    SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
   BalloonTip(Button1, 2, 'SS',
  'http://lear4u.blogsky.com', clRed, clYellow);
end

آموزش خصوصی!

با سلام یکی از دوستان در مورد آموزش خصوصی پرسیده بود خدمت دوستمون عرض کنم شما شروع کنید هر جا مشکل داشتید من همه جوره در خدمتیم.برای شروع همه میتوانید یک ایبوک آموزشی از اینترنت بدون هیچ هزینه ای تهیه کنند و مفاهیم اولیه حتما یاد بگیرید تاکیید می کنند کتاب های سطح مبتدی را انتخاب کنندو این اشتباه را تکرار نکنند که از سطوح بالاتر شروع کنند.و همچنین کتاب الگورتیم و فلوچارت یادتون نره.