📄 macform.pas

📁 Clock 桌面时钟日历阴历看到的delphi程序转发
💻 PAS
📖 第 1 页 / 共 2 页
字号:
上一页 12
Procedure TMacPanel.SetNoBorder(Value: Boolean);
Begin
  If FNoBorder <> Value Then
  Begin
    FNoBorder := Value;
    invalidate;
  End;
End;

Constructor TMacTwoButton.Create(AOwner: TComponent);
Begin
  Inherited;

  bMouseIn := false;
  bmpOut := TBitmap.Create;
End;

Destructor TMacTwoButton.Destroy;
Begin
  bmpOut.Free;
  Inherited;
End;

Procedure TMacTwoButton.Paint;
Var
  rt: Trect;
Begin
  Inherited;

  rt := ClientRect;
  canvas.Brush.Style := bsClear;
  If FResID = 0 Then
  Begin
    With Canvas Do
    Begin
      Brush.Color := clBtnFace;
      FillRect(rt);

      Case bMouseIn Of
        True:
          Begin
            Frame3D(Canvas, rt, clBtnHighlight, clBtnShadow, 1);
          End;
        False:
          Begin
            Frame3D(Canvas, rt, clBtnShadow, clBtnHighlight, 1);
          End;
      End;

    End;
    exit;
  End;
  setRect(rt, 0, 0, bmpIn.Width, bmpIn.Height);

  Case bMouseIn Of
    True:
      Begin
        Canvas.CopyRect(rt, bmpIn.Canvas, rt);
      End;
    False:
      Begin
        Canvas.CopyRect(rt, bmpOut.Canvas, rt);
      End;
  End;
End;

Procedure TMacTwoButton.SetResID(Value: Integer);
Var
  bmp: TBitmap;
  rt: TRect;
Begin

  If FResID <> Value Then
  Begin
    FResID := Value;
    Try
      bmp := TBitmap.Create;
      bmp.LoadFromResourceID(HInstance, FResID);
      aWidth := bmp.Width Div 2;

      If (aWidth <> Width) Or (bmp.Height <> Height) Then
      Begin
        Width := aWidth;

        Height := bmp.Height;

        bmpOut.Width := aWidth;
        bmpOut.Height := Height;
        bmpIn.Width := aWidth;
        bmpIn.Height := Height;
      End;

      setRect(rt, 0, 0, aWidth, Height);

      bmpIn.Canvas.CopyRect(Rt, bmp.Canvas, rt);
      bmpout.Canvas.CopyRect(Rt, bmp.Canvas, Rect(aWidth, 0, 2 * aWidth,
        Height));

      bmp.Free;
    Except
      FResID := 0;
    End;

    Invalidate;
  End;
End;

Constructor TMacButton.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 2005;

End;

Procedure TMacCheckButton.MouseEnter(Var Msg: TMessage);
Begin
End;

Procedure TMacCheckButton.MouseLeave(Var Msg: TMessage);
Begin
End;

Procedure TMacCheckButton.Click;
Begin
  FChecked := Not FChecked;

  bMouseIn := FChecked;
  Invalidate;

  Inherited;
End;

Constructor TMacCheckButton.Create(AOwner: TComponent);
Begin
  Inherited;
  FChecked := false;
  ResID := 2006;
End;

Procedure TMacCheckButton.SetChecked(Value: Boolean);
Begin
  If FChecked <> Value Then
  Begin
    FChecked := Value;
    bMouseIn := FChecked;

    Invalidate;
  End;
End;

Constructor TMacHeader.Create(AOwner: TComponent);
Begin
  Inherited;
  Align := alTop;

  Bitmap := TBitmap.Create;
  Bitmap.LoadFromResourceID(HInstance, 2002);
  Height := Bitmap.Height;

  MacMin := TMacMinButton.Create(Self);
  With MacMin Do
  Begin
    Top := 2;
    Hint := 'Minimize';
  End;
  InsertControl(MacMin);

  MacClose := TMacCloseButton.Create(Self);
  With MacClose Do
  Begin
    Top := 2;
    Hint := 'Close';
    OnClick := CloseClick;
  End;
  InsertControl(MacClose);

  Font.Height := -10;
End;

Destructor TMacHeader.Destroy;
Begin
  Bitmap.Free;
  MacMin.Free;
  Inherited;
End;

Procedure TMacHeader.Paint;
Var
  w, h: Integer;
Begin
  With Canvas Do
  Begin
    StretchDraw(ClientRect, Bitmap);

    Brush.Color := $808080;
    FrameRect(ClientRect);

    w := (Width - TextWidth(Caption)) Div 2;
    h := (Height - TextHeight(Caption)) Div 2;

    Brush.Style := bsClear;
    TextOut(w, h, Caption);
  End;
End;

Procedure TMacHeader.NCHITTEST(Var Message: TMessage);
Begin
  PostMessage(Parent.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
End;

Procedure TMacHeader.Resize;
Begin
  Inherited;
  MacMin.Left := Width - MacMin.Width - 2;
  MacClose.Left := 1;
End;

Procedure TMacHeader.CloseClick(Sender: TObject);
Begin
  If Assigned(FOnCloseClick) Then
    FOnCloseClick(self);
End;

Constructor TMacCloseButton.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 2003;
  Hint := 'Close';
  Cursor := crHandPoint;
End;

Procedure TMacCloseButton.Click;
Begin
  Inherited;
End;

Constructor TMacMinButton.Create(AOwner: TComponent);
Begin
  Inherited;
  Hint := 'Minimize';
  ResID := 2004;
  Cursor := crHandPoint;
End;

Procedure TMacMinButton.Click;
Begin
  Inherited;

  Parent.Parent.Visible := False;
End;

Constructor TMacSmallButton.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 2008;
  Hint := 'Open';
  Cursor := crHandPoint;
End;

Constructor TMacBody.Create(AOwner: TComponent);
Begin
  Inherited;
  Align := alClient;
  BorderWidth := 1;
End;

Constructor TMacLeftButton.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 2010;
  Cursor := crHandPoint;
End;

Constructor TMacRightButton.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 2007;
  Cursor := crHandPoint;
End;

Constructor TSmoothFont.CreateNew;
Begin
  Inherited Create;

  BigBmp := TBitmap.Create;
  tmpBmp := TBitmap.Create;
End;

Destructor TSmoothFont.Destroy;
Begin
  BigBmp.Free;
  tmpBmp.Free;
  Inherited;
End;

Procedure TSmoothFont.Draw(AX, AY: Integer; Canvas: TCanvas; Const Text:
  String);
Var
  wid, hgt, x, y: Integer;
  r, g, b, totr, totg, totb: Integer;
Begin
  With BigBmp Do
  Begin
    With Canvas Do
    Begin
      Font.Assign(Self);
      font.Size := 2 * Font.Size;

      wid := TextWidth(Text);
      hgt := trunc(TextHeight(Text) * 1.1);

      Width := wid;
      Height := hgt;

      TextOut(0, 0, Text);
    End;

    wid := wid Div 2;
    hgt := hgt Div 2;

    tmpBmp.Width := wid;
    tmpBmp.Height := hgt;

    For y := 0 To (Height - 3) Div 2 Do
    Begin
      For x := 0 To (Width - 3) Div 2 Do
      Begin
        totr := 0;
        totg := 0;
        totb := 0;

        ColorToRGB(Canvas.Pixels[2 * x, 2 * y], r, g, b);
        totr := totr + r;
        totg := totg + g;
        totb := totb + b;

        ColorToRGB(Canvas.Pixels[2 * x + 1, 2 * y], r, g, b);
        totr := totr + r;
        totg := totg + g;
        totb := totb + b;

        ColorToRGB(Canvas.Pixels[2 * x, 2 * y + 1], r, g, b);
        totr := totr + r;
        totg := totg + g;
        totb := totb + b;

        ColorToRGB(Canvas.Pixels[2 * x + 1, 2 * y + 1], r, g, b);
        totr := totr + r;
        totg := totg + g;
        totb := totb + b;

        tmpBmp.Canvas.Pixels[x, y] := RGB(totr Div 4, totg Div 4, totb Div 4);
      End;
    End;
  End;
  BitBlt(Canvas.Handle, AX, AY, wid, hgt, tmpBmp.Canvas.Handle, 0, 0, SRCCOPY);
End;

Function TSmoothFont.TextSize(Const Text: String): TSize;
Begin
  With BigBmp.Canvas Do
  Begin
    Font.Assign(Self);
    font.Size := 2 * Font.Size;
    Result.cx := TextWidth(Text) Div 2;
    Result.cy := trunc(TextHeight(Text) * 1.1) Div 2;
  End;

End;

Constructor TMacBaseButton.Create(AOwner: TComponent);
Begin
  Inherited;
  ShowHint := true;
  bmpIn := TBitmap.Create;

  FResID := 0;

End;

Destructor TMacBaseButton.Destroy;
Begin
  bmpIn.Free;
  Inherited;
End;

Procedure TMacBaseButton.SetResID(Value: Integer);
Begin

End;

Procedure TMacBaseButton.MouseEnter(Var Msg: TMessage);
Begin
  bMouseIn := true;

  Invalidate;
End;

Procedure TMacBaseButton.MouseLeave(Var Msg: TMessage);
Begin
  bMouseIn := false;

  Invalidate;
End;

Procedure TMacOneButton.SetResID(Value: Integer);
Begin

  If FResID <> Value Then
  Begin
    FResID := Value;
    Try
      bmpIn.LoadFromResourceID(HInstance, FResID);

      If (bmpIn.Width <> Width) Or (bmpIn.Height <> Height) Then
      Begin
        Width := bmpIn.Width;
        Height := bmpIn.Height;
      End;
    Except
      FResID := 0;
    End;

    Invalidate;
  End;
End;

Procedure TMacOneButton.Paint;
Var
  rt: Trect;
Begin
  Inherited;

  rt := ClientRect;
  If FResID = 0 Then
  Begin
    With Canvas Do
    Begin
      Brush.Color := clBtnFace;
      FillRect(rt);

      Case bMouseIn Of
        True:
          Begin
            Frame3D(Canvas, rt, clBtnHighlight, clBtnShadow, 1);
          End;
        False:
          Begin
            Frame3D(Canvas, rt, clBtnShadow, clBtnHighlight, 1);
          End;
      End;
    End;
    exit;
  End;
  setRect(rt, 0, 0, Width, Height);

  Canvas.BrushCopy(rt, bmpIn, rt, clFuchsia);

End;

Constructor TMacPrevYear.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 3003;
  hint := '上一月';
  Cursor := crHandPoint;
End;

Constructor TMacPrevMonth.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 3001;
  hint := '上一年';
  Cursor := crHandPoint;
End;

Constructor TMacNextYear.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 3004;
  hint := '下一年';
  Cursor := crHandPoint;
End;

Constructor TMacNextMonth.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 3002;
  hint := '下一月';
  Cursor := crHandPoint;
End;

Constructor TMacCurrent.Create(AOwner: TComponent);
Begin
  Inherited;
  ResID := 3005;
  Hint := '到今天';
  Cursor := crHandPoint;
End;

Initialization
  AppName := ParamStr(0);
  AppPath := IncludeTrailingPathDelimiter(ExtractFilePath(AppName));

  AppReg := TRegistry.Create;
  AppReg.RootKey := HKEY_LOCAL_MACHINE;

  AppInf := TIniFile.Create(ChangeFileExt(AppName, '.ini'));

  Setlength(WinPath, MAX_PATH);
  Setlength(WinPath, GetWindowsDirectory(PChar(WinPath), MAX_PATH));
  WinPath := IncludeTrailingPathDelimiter(WinPath);
Finalization

  AppReg.Free;
  AppInf.Free;
End.
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -